home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / cmds / as / dist / vms.c < prev    next >
Encoding:
C/C++ Source or Header  |  1989-03-01  |  54.7 KB  |  2,572 lines
  1. /* vms.c -- Write out a VAX/VMS object file
  2.    Copyright (C) 1987, 1988 David L. Kashtan and Free Software Foundation, Inc.
  3.  
  4. This file is part of GAS, the GNU Assembler.
  5.  
  6. GAS is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. GAS is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GAS; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20.  
  21. #include <ctype.h>
  22. #include <stdio.h>
  23. #include "as.h"
  24. #include "md.h"
  25. #include "subsegs.h"
  26. #include "obstack.h"
  27. #include "struc-symbol.h"
  28. #include "write.h"
  29. #include "symbols.h"
  30.  
  31. #ifdef    VMS        /* THIS MODULE IS FOR VMS ONLY */
  32.  
  33. #include <stab.h>
  34. #include "objrecdef.h"            /* Define VMS Object record lang. */
  35. #include <vms/fabdef.h>            /* Define File Access Block      */
  36. #include <vms/namdef.h>            /* Define NAM Block          */
  37. #include <vms/xabdef.h>            /* Define XAB              */
  38. #include <vms/xabdatdef.h>        /* Define Date XAB          */
  39. #include <vms/xabfhcdef.h>        /* Define File Header XAB      */
  40.  
  41. /*
  42.  *    Version string of the compiler that produced the code we are
  43.  *    assembling.
  44.  */
  45. char *compiler_version_string;
  46.  
  47. static symbolS *Entry_Point_Symbol = 0;    /* Pointer to "_main"     */
  48.  
  49. /*
  50.  *    We augment the "gas" symbol structure with this
  51.  */
  52. struct VMS_Symbol {
  53.     struct VMS_Symbol *Next;
  54.     struct symbol *Symbol;
  55.     int Size;
  56.     int Psect_Index;
  57.     int Psect_Offset;
  58.     };
  59. static struct VMS_Symbol *VMS_Symbols = 0;
  60.  
  61.  
  62. /*
  63.  *    If the procedure "main()" exists we have to add the instruction
  64.  *    "jsb c$main_args" at the beginning to be compatible with VAX-11 "C".
  65.  */
  66. VMS_Check_For_Main()
  67. {
  68.   register symbolS *symbolP;
  69. #ifdef    HACK_DEC_C_STARTUP
  70.   register struct frchain *frchainP;
  71.   register fragS *fragP;
  72.   register fragS **prev_fragPP;
  73.   register struct fix *fixP;
  74.   register fragS *New_Frag;
  75.   int i;
  76. #endif    HACK_DEC_C_STARTUP
  77.  
  78.   symbolP = (struct symbol *)symbol_find("_main");
  79.   if (symbolP && (symbolP->sy_nlist.n_type == (N_TEXT | N_EXT))) {
  80. #ifndef    HACK_DEC_C_STARTUP
  81.     /*
  82.      *    Remember the entry point symbol
  83.      */
  84.     Entry_Point_Symbol = symbolP;
  85. #else    HACK_DEC_C_STARTUP
  86.     /*
  87.      *    Scan all the fragment chains for the one with "_main"
  88.      *    (Actually we know the fragment from the symbol, but we need
  89.      *     the previous fragment so we can change its pointer)
  90.      */
  91.     frchainP = frchain_root;
  92.     while(frchainP) {
  93.         /*
  94.          *    Scan all the fragments in this chain, remembering
  95.          *    the "previous fragment"
  96.          */
  97.         prev_fragPP = &frchainP->frch_root;
  98.         fragP = frchainP->frch_root;
  99.         while(fragP && (fragP != frchainP->frch_last)) {
  100.             /*
  101.              *    Is this the fragment?
  102.              */
  103.             if (fragP == symbolP->sy_frag) {
  104.                 /*
  105.                  *    Yes: Modify the fragment by replacing
  106.                  *         it with a new fragment.
  107.                  */
  108.                 New_Frag = (fragS *)
  109.                     xmalloc(sizeof(*New_Frag) +
  110.                             fragP->fr_fix +
  111.                             fragP->fr_var +
  112.                             5);
  113.                 /*
  114.                  *    The fragments are the same except
  115.                  *    that the "fixed" area is larger
  116.                  */
  117.                 *New_Frag = *fragP;
  118.                 New_Frag->fr_fix += 6;
  119.                 /*
  120.                  *    Copy the literal data opening a hole
  121.                  *    2 bytes after "_main" (i.e. just after
  122.                  *    the entry mask).  Into which we place
  123.                  *    the JSB instruction.
  124.                  */
  125.                 New_Frag->fr_literal[0] = fragP->fr_literal[0];
  126.                 New_Frag->fr_literal[1] = fragP->fr_literal[1];
  127.                 New_Frag->fr_literal[2] = 0x16; /* Jsb */
  128.                 New_Frag->fr_literal[3] = 0xef;
  129.                 New_Frag->fr_literal[4] = 0;
  130.                 New_Frag->fr_literal[5] = 0;
  131.                 New_Frag->fr_literal[6] = 0;
  132.                 New_Frag->fr_literal[7] = 0;
  133.                 for(i = 2; i < fragP->fr_fix + fragP->fr_var; i++)
  134.                     New_Frag->fr_literal[i+6] =
  135.                         fragP->fr_literal[i];
  136.                 /*
  137.                  *    Now replace the old fragment with the
  138.                  *    newly generated one.
  139.                  */
  140.                 *prev_fragPP = New_Frag;
  141.                 /*
  142.                  *    Remember the entry point symbol
  143.                  */
  144.                 Entry_Point_Symbol = symbolP;
  145.                 /*
  146.                  *    Scan the text area fixup structures
  147.                  *    as offsets in the fragment may have
  148.                  *    changed
  149.                  */
  150.                 for(fixP = text_fix_root; fixP; fixP = fixP->fx_next) {
  151.                     /*
  152.                      *    Look for references to this
  153.                      *    fragment.
  154.                      */
  155.                     if (fixP->fx_frag == fragP) {
  156.                         /*
  157.                          *    Change the fragment
  158.                          *    pointer
  159.                          */
  160.                         fixP->fx_frag = New_Frag;
  161.                         /*
  162.                          *    If the offset is after
  163.                          *    the entry mask we need
  164.                          *    to account for the JSB
  165.                          *    instruction we just
  166.                          *    inserted.
  167.                          */
  168.                         if (fixP->fx_where >= 2)
  169.                             fixP->fx_where += 6;
  170.                     }
  171.                 }
  172.                 /*
  173.                  *    Scan the symbols as offsets in the
  174.                  *    fragment may have changed
  175.                  */
  176.                 for(symbolP = symbol_rootP;
  177.                     symbolP;
  178.                     symbolP = symbolP->sy_next) {
  179.                     /*
  180.                      *    Look for references to this
  181.                      *    fragment.
  182.                      */
  183.                     if (symbolP->sy_frag == fragP) {
  184.                         /*
  185.                          *    Change the fragment
  186.                          *    pointer
  187.                          */
  188.                         symbolP->sy_frag = New_Frag;
  189.                         /*
  190.                          *    If the offset is after
  191.                          *    the entry mask we need
  192.                          *    to account for the JSB
  193.                          *    instruction we just
  194.                          *    inserted.
  195.                          */
  196.                         if (symbolP->sy_nlist.n_value >= 2)
  197.                             symbolP->sy_nlist.n_value += 6;
  198.                     }
  199.                 }
  200.                 /*
  201.                  *    Make a symbol reference to
  202.                  *    "_c$main_args" so we can get
  203.                  *    its address inserted into the
  204.                  *    JSB instruction.
  205.                  */
  206.                 symbolP = (symbolS *)xmalloc(sizeof(*symbolP));
  207.                 symbolP->sy_nlist.n_un.n_name = "_c$main_args";
  208.                 symbolP->sy_nlist.n_type = N_UNDF;
  209.                 symbolP->sy_nlist.n_other = 0;
  210.                 symbolP->sy_nlist.n_desc = 0;
  211.                 symbolP->sy_nlist.n_value = 0;
  212.                 symbolP->sy_name_offset = 0;
  213.                 symbolP->sy_number = 0;
  214.                 symbolP->sy_frag = New_Frag;
  215.                 symbolP->sy_forward = 0;
  216.                 symbolP->sy_next = symbol_rootP;
  217.                 symbol_rootP = symbolP;
  218.                 /*
  219.                  *    Generate a text fixup structure
  220.                  *    to get "_c$main_args" stored into the
  221.                  *    JSB instruction.
  222.                  */
  223.                 fixP = (struct fix *)xmalloc(sizeof(*fixP));
  224.                 fixP->fx_frag = New_Frag;
  225.                 fixP->fx_where = 4;
  226.                 fixP->fx_addsy = symbolP;
  227.                 fixP->fx_subsy = 0;
  228.                 fixP->fx_offset = 0;
  229.                 fixP->fx_size = sizeof(long);
  230.                 fixP->fx_pcrel = 1;
  231.                 fixP->fx_next = text_fix_root;
  232.                 text_fix_root = fixP;
  233.                 /*
  234.                  *    Now make sure we exit from the loop
  235.                  */
  236.                 frchainP = 0;
  237.                 break;
  238.             }
  239.             /*
  240.              *    Try the next fragment
  241.              */
  242.             prev_fragPP = &fragP->fr_next;
  243.             fragP = fragP->fr_next;
  244.         }
  245.         /*
  246.          *    Try the next fragment chain
  247.          */
  248.         if (frchainP) frchainP=frchainP->frch_next;
  249.     }
  250. #endif    HACK_DEC_C_STARTUP
  251.   }
  252. }
  253.  
  254. /*
  255.  *    Write a VAX/VMS object file (everything else has been done!)
  256.  */
  257. VMS_write_object_file(text_siz, data_siz, text_frag_root, data_frag_root)
  258. unsigned text_siz;
  259. unsigned data_siz;
  260. struct frag *text_frag_root;
  261. struct frag *data_frag_root;
  262. {
  263.    register fragS *        fragP;
  264.    register symbolS *        symbolP;
  265.    register symbolS *        sp;
  266.    register struct fix *    fixP;
  267.    register struct VMS_Symbol *    vsp;
  268.    int Local_Initialized_Data_Size = 0;
  269.    int Psect_Number = 0;        /* Psect Index Number */
  270.    int Text_Psect = -1;            /* Text Psect Index   */
  271.    int Data_Psect = -1;            /* Data Psect Index   */
  272.    int Bss_Psect = -1;            /* Bss Psect Index    */
  273.  
  274.    /*
  275.     *    Create the VMS object file
  276.     */
  277.    Create_VMS_Object_File();
  278.    /*
  279.     *    Write the module header records
  280.     */
  281.    Write_VMS_MHD_Records();
  282.  
  283.     /*
  284.      *    Generate the VMS object file records
  285.      *    1st GSD then TIR records
  286.      */
  287.  
  288.     /*******       Global Symbol Dictionary       *******/
  289.     /*
  290.      *    Define the Text Psect
  291.      */
  292.     if (text_siz > 0) {
  293.         Text_Psect = Psect_Number++;
  294.         VMS_Psect_Spec("$code",text_siz,"TEXT");
  295.     }
  296.     /*
  297.      *    Define the BSS Psect
  298.      */
  299.     if (local_bss_counter > 0) {
  300.         Bss_Psect = Psect_Number++;
  301.         VMS_Psect_Spec("$uninitialized_data",local_bss_counter,"DATA");
  302.     }
  303.     /*
  304.      *    Now scan the symbols and emit the appropriate GSD records
  305.      */
  306.     for (sp = symbol_rootP; sp; sp = sp->sy_next) {
  307.         /*
  308.          *    Dispatch on symbol type
  309.          */
  310.         switch(sp->sy_type) {
  311.             /*
  312.              *    Global uninitialized data
  313.              */
  314.             case N_UNDF | N_EXT:
  315.                 /*
  316.                  *    Make a VMS data symbol entry
  317.                  */
  318.                 vsp = (struct VMS_Symbol *)
  319.                     xmalloc(sizeof(*vsp));
  320.                 vsp->Symbol = sp;
  321.                 vsp->Size = sp->sy_nlist.n_value;
  322.                 vsp->Psect_Index = Psect_Number++;
  323.                 vsp->Psect_Offset = 0;
  324.                 vsp->Next = VMS_Symbols;
  325.                 VMS_Symbols = vsp;
  326.                 sp->sy_number = (int)vsp;
  327.                 /*
  328.                  *    Make the psect for this data
  329.                  */
  330.                 VMS_Psect_Spec(sp->sy_nlist.n_un.n_name,
  331.                            vsp->Size,
  332.                            "COMMON");
  333. #ifdef    NOT_VAX_11_C_COMPATIBLE
  334.                 /*
  335.                  *    Place a global symbol at the
  336.                  *    beginning of the Psect
  337.                  */
  338.                 VMS_Global_Symbol_Spec(sp->sy_nlist.n_un.n_name,
  339.                                vsp->Psect_Index,
  340.                                0,
  341.                                1);
  342. #endif    NOT_VAX_11_C_COMPATIBLE
  343.                 break;
  344.             /*
  345.              *    Local uninitialized data
  346.              */
  347.             case N_BSS:
  348.                 /*
  349.                  *    Make a VMS data symbol entry
  350.                  */
  351.                 vsp = (struct VMS_Symbol *)
  352.                     xmalloc(sizeof(*vsp));
  353.                 vsp->Symbol = sp;
  354.                 vsp->Size = 0;
  355.                 vsp->Psect_Index = Bss_Psect;
  356.                 vsp->Psect_Offset =
  357.                     sp->sy_nlist.n_value -
  358.                         bss_address_frag . fr_address;
  359.                 vsp->Next = VMS_Symbols;
  360.                 VMS_Symbols = vsp;
  361.                 sp->sy_number = (int)vsp;
  362.                 break;
  363.             /*
  364.              *    Global initialized data
  365.              */
  366.             case N_DATA | N_EXT:
  367.                 /*
  368.                  *    Make a VMS data symbol entry
  369.                  */
  370.                 vsp = (struct VMS_Symbol *)
  371.                     xmalloc(sizeof(*vsp));
  372.                 vsp->Symbol = sp;
  373.                 vsp->Size = VMS_Initialized_Data_Size(sp,
  374.                             text_siz + data_siz);
  375.                 vsp->Psect_Index = Psect_Number++;
  376.                 vsp->Psect_Offset = 0;
  377.                 vsp->Next = VMS_Symbols;
  378.                 VMS_Symbols = vsp;
  379.                 sp->sy_number = (int)vsp;
  380.                 /*
  381.                  *    Make its psect
  382.                  */
  383.                 VMS_Psect_Spec(sp->sy_nlist.n_un.n_name,
  384.                            vsp->Size,
  385.                            "COMMON");
  386. #ifdef    NOT_VAX_11_C_COMPATIBLE
  387.                 /*
  388.                  *    Place a global symbol at the
  389.                  *    beginning of the Psect
  390.                  */
  391.                 VMS_Global_Symbol_Spec(sp->sy_nlist.n_un.n_name,
  392.                                vsp->Psect_Index,
  393.                                0,
  394.                                1);
  395. #endif    NOT_VAX_11_C_COMPATIBLE
  396.                 break;
  397.             /*
  398.              *    Local initialized data
  399.              */
  400.             case N_DATA:
  401.                 /*
  402.                  *    Make a VMS data symbol entry
  403.                  */
  404.                 vsp = (struct VMS_Symbol *)
  405.                     xmalloc(sizeof(*vsp));
  406.                 vsp->Symbol = sp;
  407.                 vsp->Size = 
  408.                     VMS_Initialized_Data_Size(sp,
  409.                               text_siz + data_siz);
  410.                 vsp->Psect_Index = Data_Psect;
  411.                 vsp->Psect_Offset =
  412.                     Local_Initialized_Data_Size;
  413.                 Local_Initialized_Data_Size += vsp->Size;
  414.                 vsp->Next = VMS_Symbols;
  415.                 VMS_Symbols = vsp;
  416.                 sp->sy_number = (int)vsp;
  417.                 break;
  418.             /*
  419.              *    Global Text definition
  420.              */
  421.             case N_TEXT | N_EXT: {
  422.                 unsigned short Entry_Mask;
  423.  
  424.                 /*
  425.                  *    Get the entry mask
  426.                  */
  427.                 fragP = sp->sy_frag;
  428.                 Entry_Mask = (fragP->fr_literal[0] & 0xff) +
  429.                         ((fragP->fr_literal[1] & 0xff)
  430.                             << 8);
  431.                 /*
  432.                  *    Define the Procedure entry pt.
  433.                  */
  434.                 VMS_Procedure_Entry_Pt(sp->sy_nlist.n_un.n_name,
  435.                                Text_Psect,
  436.                                sp->sy_nlist.n_value,
  437.                                Entry_Mask);
  438.                 break;
  439.             }
  440.             /*
  441.              *    Local Text definition
  442.              */
  443.             case N_TEXT:
  444.                 /*
  445.                  *    Make a VMS data symbol entry
  446.                  */
  447.                 vsp = (struct VMS_Symbol *)
  448.                     xmalloc(sizeof(*vsp));
  449.                 vsp->Symbol = sp;
  450.                 vsp->Size = 0;
  451.                 vsp->Psect_Index = Text_Psect;
  452.                 vsp->Psect_Offset = sp->sy_nlist.n_value;
  453.                 vsp->Next = VMS_Symbols;
  454.                 VMS_Symbols = vsp;
  455.                 sp->sy_number = (int)vsp;
  456.                 break;
  457.             /*
  458.              *    Global Reference
  459.              */
  460.             case N_UNDF:
  461.                 /*
  462.                  *    Make a GSD global symbol reference
  463.                  *    record.
  464.                  */
  465.                 VMS_Global_Symbol_Spec(sp->sy_nlist.n_un.n_name,
  466.                                0,
  467.                                0,
  468.                                0);
  469.                 break;
  470.             /*
  471.              *    Anything else
  472.              */
  473.             default:
  474.                 /*
  475.                  *    Ignore STAB symbols
  476.                  */
  477.                 if ((sp->sy_type & N_STAB) != 0) break;
  478.                 /*
  479.                  *    Error
  480.                  */
  481.                 printf(" ERROR, unknown type (%d)\n",
  482.                         sp->sy_nlist.n_type);
  483.                 break;
  484.         }
  485.     }
  486.     /*
  487.      *    Define the Data Psect
  488.      */
  489.     if ((data_siz > 0) && (Local_Initialized_Data_Size > 0)) {
  490.         /*
  491.          *    Do it
  492.          */
  493.         Data_Psect = Psect_Number++;
  494.         VMS_Psect_Spec("$data",
  495.                 Local_Initialized_Data_Size,
  496.                 "DATA");
  497.         /*
  498.          *    Scan the VMS symbols and fill in the data psect
  499.          */
  500.         for (vsp = VMS_Symbols; vsp; vsp = vsp->Next) {
  501.             /*
  502.              *    Only look for undefined psects
  503.              */
  504.             if (vsp->Psect_Index < 0)  {
  505.                 /*
  506.                  *    And only initialized data
  507.                  */
  508.                 if (vsp->Symbol->sy_nlist.n_type == N_DATA)
  509.                     vsp->Psect_Index = Data_Psect;
  510.             }
  511.         }
  512.     }
  513.  
  514.     /*******  Text Information and Relocation Records  *******/
  515.     /*
  516.      *    Write the text segment data
  517.      */
  518.     if (text_siz > 0) {
  519.         /*
  520.          *    Scan the text fragments
  521.          */
  522.         for(fragP = text_frag_root; fragP; fragP = fragP->fr_next) {
  523.             /*
  524.              *    Stop if we get to the data fragments
  525.              */
  526.             if (fragP == data_frag_root) break;
  527.             /*
  528.              *    Ignore fragments with no data
  529.              */
  530.             if ((fragP->fr_fix == 0) && (fragP->fr_var == 0))
  531.                 continue;
  532.             /*
  533.              *    Go the the appropriate offset in the
  534.              *    Text Psect.
  535.              */
  536.             VMS_Set_Psect(Text_Psect,fragP->fr_address,OBJ$C_TIR);
  537.             /*
  538.              *    Store the "fixed" part
  539.              */
  540.             if (fragP->fr_fix)
  541.                 VMS_Store_Immediate_Data(fragP->fr_literal,
  542.                              fragP->fr_fix,
  543.                              OBJ$C_TIR);
  544.             /*
  545.              *    Store the "variable" part
  546.              */
  547.             if (fragP->fr_var && fragP->fr_offset)
  548.                 VMS_Store_Repeated_Data(fragP->fr_offset,
  549.                             fragP->fr_literal+
  550.                                  fragP->fr_fix,
  551.                             fragP->fr_var,
  552.                             OBJ$C_TIR);
  553.         }
  554.         /*
  555.          *    Now we go through the text segment fixups and
  556.          *    generate TIR records to fix up addresses within
  557.          *    the Text Psect
  558.          */
  559.         for(fixP = text_fix_root; fixP; fixP = fixP->fx_next) {
  560.             /*
  561.              *    We DO handle the case of "Symbol - Symbol" as
  562.              *    long as it is in the same segment.
  563.              */
  564.             if (fixP->fx_subsy && fixP->fx_addsy) {
  565.                 int i;
  566.  
  567.                 /*
  568.                  *    They need to be in the same segment
  569.                  */
  570.                 if (fixP->fx_subsy->sy_type !=
  571.                             fixP->fx_addsy->sy_type)
  572.                     error("Fixup data addsy and subsy didn't have the same type");
  573.                 /*
  574.                  *    And they need to be in one that we
  575.                  *    can check the psect on
  576.                  */
  577.                 if (((fixP->fx_addsy->sy_type & ~N_EXT) != N_DATA) &&
  578.                     ((fixP->fx_addsy->sy_type & ~N_EXT) != N_TEXT))
  579.                     error("Fixup data addsy and subsy didn't have an appropriate type");
  580.                 /*
  581.                  *    This had better not be PC relative!
  582.                  */
  583.                 if (fixP->fx_pcrel)
  584.                     error("Fixup data was erroneously \"pcrel\"");
  585.                 /*
  586.                  *    Subtract their values to get the
  587.                  *    difference.
  588.                  */
  589.                 i = fixP->fx_addsy->sy_value -
  590.                         fixP->fx_subsy->sy_value;
  591.                 /*
  592.                  *    Now generate the fixup object records
  593.                  *    Set the psect and store the data
  594.                  */
  595.                 VMS_Set_Psect(Text_Psect,
  596.                           fixP->fx_where +
  597.                              fixP->fx_frag->fr_address,
  598.                           OBJ$C_TIR);
  599.                 VMS_Store_Immediate_Data(&i,
  600.                              fixP->fx_size,
  601.                              OBJ$C_TIR);
  602.                 /*
  603.                  *    Done
  604.                  */
  605.                 continue;
  606.             }
  607.             /*
  608.              *    Size will HAVE to be "long"
  609.              */
  610.             if (fixP->fx_size != sizeof(long))
  611.                 error("Fixup datum was not a longword");
  612.             /*
  613.              *    Symbol must be "added" (if it is ever
  614.              *                subtracted we can
  615.              *                fix this assumption)
  616.              */
  617.             if (fixP->fx_addsy == 0)
  618.                 error("Fixup datum was not \"fixP->fx_addsy\"");
  619.             /*
  620.              *    Store the symbol value in a PIC fashion
  621.              */
  622.             VMS_Store_PIC_Symbol_Reference(fixP->fx_addsy,
  623.                                fixP->fx_offset,
  624.                                fixP->fx_pcrel,
  625.                                Text_Psect,
  626.                                fixP->fx_where +
  627.                                   fixP->fx_frag->fr_address,
  628.                                OBJ$C_TIR);
  629.             /*
  630.              *    Check for indirect address reference,
  631.              *    which has to be fixed up (as the linker
  632.              *    will screw it up with TIR$C_STO_PICR).
  633.              */
  634.             if (fixP->fx_pcrel)
  635.                 VMS_Fix_Indirect_Reference(Text_Psect,
  636.                                fixP->fx_where +
  637.                                 fixP->fx_frag->fr_address,
  638.                                fixP->fx_frag,
  639.                                text_frag_root);
  640.         }
  641.     }
  642.     /*
  643.      *    Store the Data segment:
  644.      *
  645.      *    Since this is REALLY hard to do any other way,
  646.      *    we actually manufacture the data segment and
  647.      *    the store the appropriate values out of it.
  648.      */
  649.     if (data_siz > 0) {
  650.         char *Data_Segment;
  651.  
  652.         /*
  653.          *    Allocate the data segment
  654.          */
  655.         Data_Segment = (char *)xmalloc(data_siz);
  656.         /*
  657.          *    Run through the data fragments, filling in the segment
  658.          */
  659.         for(fragP = data_frag_root; fragP; fragP = fragP->fr_next) {
  660.             register long int        count;
  661.             register char     *        fill_literal;
  662.             register long int        fill_size;
  663.             int i;
  664.  
  665.             i = fragP->fr_address - text_siz;
  666.             if (fragP->fr_fix)
  667.                 bcopy(fragP->fr_literal,
  668.                       Data_Segment + i,
  669.                       fragP->fr_fix);
  670.             i += fragP->fr_fix;
  671.  
  672.             fill_literal= fragP -> fr_literal + fragP -> fr_fix;
  673.             fill_size   = fragP -> fr_var;
  674.             for (count = fragP -> fr_offset;  count;  count --) {
  675.                 if (fill_size)
  676.                     bcopy(fill_literal,
  677.                           Data_Segment + i,
  678.                           fill_size);
  679.                 i += fill_size;
  680.             }
  681.         }
  682.         /*
  683.          *    Now we can run through all the data symbols
  684.          *    and store the data
  685.          */
  686.         for(vsp = VMS_Symbols; vsp; vsp = vsp->Next) {
  687.             /*
  688.              *    Ignore anything other than data symbols
  689.              */
  690.             if ((vsp->Symbol->sy_nlist.n_type & ~N_EXT) != N_DATA)
  691.                 continue;
  692.             /*
  693.              *    Set the Psect + Offset
  694.              */
  695.             VMS_Set_Psect(vsp->Psect_Index,
  696.                       vsp->Psect_Offset,
  697.                       OBJ$C_TIR);
  698.             /*
  699.              *    Store the data
  700.              */
  701.             VMS_Store_Immediate_Data(Data_Segment +
  702.                             vsp->Symbol->sy_nlist.n_value -
  703.                                 text_siz,
  704.                          vsp->Size,
  705.                          OBJ$C_TIR);
  706.         }
  707.         /*
  708.          *    Now we go through the data segment fixups and
  709.          *    generate TIR records to fix up addresses within
  710.          *    the Data Psects
  711.          */
  712.         for(fixP = data_fix_root; fixP; fixP = fixP->fx_next) {
  713.             /*
  714.              *    Find the symbol for the containing datum
  715.              */
  716.             for(vsp = VMS_Symbols; vsp; vsp = vsp->Next) {
  717.                 /*
  718.                  *    Only bother with Data symbols
  719.                  */
  720.                 sp = vsp->Symbol;
  721.                 if ((sp->sy_nlist.n_type & ~N_EXT) != N_DATA)
  722.                     continue;
  723.                 /*
  724.                  *    Ignore symbol if After fixup
  725.                  */
  726.                 if (sp->sy_nlist.n_value >
  727.                     (fixP->fx_where +
  728.                         fixP->fx_frag->fr_address))
  729.                     continue;
  730.                 /*
  731.                  *    See if the datum is here
  732.                  */
  733.                 if ((sp->sy_nlist.n_value + vsp->Size) <=
  734.                     (fixP->fx_where +
  735.                         fixP->fx_frag->fr_address))
  736.                     continue;
  737.                 /*
  738.                  *    We DO handle the case of "Symbol - Symbol" as
  739.                  *    long as it is in the same segment.
  740.                  */
  741.                 if (fixP->fx_subsy && fixP->fx_addsy) {
  742.                     int i;
  743.  
  744.                     /*
  745.                      *    They need to be in the same segment
  746.                      */
  747.                     if (fixP->fx_subsy->sy_type !=
  748.                                 fixP->fx_addsy->sy_type)
  749.                         error("Fixup data addsy and subsy didn't have the same type");
  750.                     /*
  751.                      *    And they need to be in one that we
  752.                      *    can check the psect on
  753.                      */
  754.                     if (((fixP->fx_addsy->sy_type & ~N_EXT) != N_DATA) &&
  755.                         ((fixP->fx_addsy->sy_type & ~N_EXT) != N_TEXT))
  756.                         error("Fixup data addsy and subsy didn't have an appropriate type");
  757.                     /*
  758.                      *    This had better not be PC relative!
  759.                      */
  760.                     if (fixP->fx_pcrel)
  761.                         error("Fixup data was erroneously \"pcrel\"");
  762.                     /*
  763.                      *    Subtract their values to get the
  764.                      *    difference.
  765.                      */
  766.                     i = fixP->fx_addsy->sy_value -
  767.                             fixP->fx_subsy->sy_value;
  768.                     /*
  769.                      *    Now generate the fixup object records
  770.                      *    Set the psect and store the data
  771.                      */
  772.                     VMS_Set_Psect(vsp->Psect_Index,
  773.                               fixP->fx_frag->fr_address +
  774.                                 fixP->fx_where -
  775.                               vsp->Symbol->sy_value +
  776.                                 vsp->Psect_Offset,
  777.                               OBJ$C_TIR);
  778.                     VMS_Store_Immediate_Data(&i,
  779.                                  fixP->fx_size,
  780.                                  OBJ$C_TIR);
  781.                     /*
  782.                      *    Done
  783.                      */
  784.                     break;
  785.                 }
  786.                 /*
  787.                  *    Size will HAVE to be "long"
  788.                  */
  789.                 if (fixP->fx_size != sizeof(long))
  790.                     error("Fixup datum was not a longword");
  791.                 /*
  792.                  *    Symbol must be "added" (if it is ever
  793.                  *                subtracted we can
  794.                  *                fix this assumption)
  795.                  */
  796.                 if (fixP->fx_addsy == 0)
  797.                     error("Fixup datum was not \"fixP->fx_addsy\"");
  798.                 /*
  799.                  *    Store the symbol value in a PIC fashion
  800.                  */
  801.                 VMS_Store_PIC_Symbol_Reference(
  802.                     fixP->fx_addsy,
  803.                     fixP->fx_offset,
  804.                     fixP->fx_pcrel,
  805.                     vsp->Psect_Index,
  806.                     fixP->fx_frag->fr_address +
  807.                         fixP->fx_where -
  808.                           vsp->Symbol->sy_value +
  809.                              vsp->Psect_Offset,
  810.                     OBJ$C_TIR);
  811.                 /*
  812.                  *    Done
  813.                  */
  814.                 break;
  815.             }
  816.             
  817.         }
  818.     }
  819.  
  820.     /*
  821.      *    Write the Traceback Begin Module record
  822.      */
  823.     VMS_TBT_Module_Begin();
  824.     /*
  825.      *    Scan the symbols and write out the routines
  826.      *    (this makes the assumption that symbols are in
  827.      *     order of ascending text segment offset)
  828.      */
  829.     {
  830.        struct symbol *Current_Routine = 0;
  831.        int Current_Line_Number = 0;
  832.        int Current_Offset = -1;
  833.        int Has_Source_File = 0;
  834.        int Largest_Line_Number = 0;
  835.  
  836.        for(symbolP = symbol_rootP; symbolP; symbolP = symbolP->sy_next) {
  837.         /*
  838.          *    Deal with text symbols
  839.          */
  840.         if ((symbolP->sy_nlist.n_type & ~N_EXT) == N_TEXT) {
  841.             /*
  842.              *    Ignore symbols starting with "L",
  843.              *    as they are local symbols
  844.              */
  845.             if (symbolP->sy_nlist.n_un.n_name[0] == 'L') continue;
  846.             /*
  847.              *    If there is a routine start defined,
  848.              *    terminate it.
  849.              */
  850.             if (Current_Routine) {
  851.                 /*
  852.                  *    End the routine
  853.                  */
  854.                 VMS_TBT_Routine_End(
  855.                     symbolP->sy_nlist.n_value -
  856.                        Current_Routine->sy_nlist.n_value);
  857.             }
  858.             /*
  859.              *    Store the routine begin traceback info
  860.              */
  861.             VMS_TBT_Routine_Begin(symbolP,Text_Psect);
  862.             Current_Routine = symbolP;
  863.             /*
  864.              *    Done
  865.              */
  866.             continue;
  867.         }
  868.         /*
  869.          *    Deal with STAB symbols
  870.          */
  871.         if ((symbolP->sy_nlist.n_type & N_STAB) != 0) {
  872.           /*
  873.            *    Dispatch on STAB type
  874.            */
  875.           switch(symbolP->sy_nlist.n_type) {
  876.             /*
  877.              *    Line number
  878.              */
  879.             case N_SLINE:
  880.                 /*
  881.                  *    If this is the 1st N_SLINE, setup
  882.                  *    PC/Line correlation.  Otherwise
  883.                  *    do the delta PC/Line.  If the offset
  884.                  *    for the line number is not +ve we need
  885.                  *    to do another PC/Line correlation
  886.                  *    setup
  887.                  */
  888.                 if (Current_Offset == -1) {
  889.                    VMS_TBT_Line_PC_Correlation(
  890.                         symbolP->sy_nlist.n_desc,
  891.                         symbolP->sy_nlist.n_value,
  892.                         Text_Psect,
  893.                         0);
  894.                 } else {
  895.                    if ((symbolP->sy_nlist.n_desc -
  896.                         Current_Line_Number) <= 0) {
  897.                     /*
  898.                      *    Line delta is not +ve, we
  899.                      *    need to close the line and
  900.                      *    start a new PC/Line
  901.                      *    correlation.
  902.                      */
  903.                     VMS_TBT_Line_PC_Correlation(0,
  904.                         symbolP->sy_nlist.n_value -
  905.                             Current_Offset,
  906.                         0,
  907.                         -1);
  908.                     VMS_TBT_Line_PC_Correlation(
  909.                         symbolP->sy_nlist.n_desc,
  910.                         symbolP->sy_nlist.n_value,
  911.                         Text_Psect,
  912.                         0);
  913.                    } else {
  914.                     /*
  915.                      *    Line delta is +ve, all is well
  916.                      */
  917.                     VMS_TBT_Line_PC_Correlation(
  918.                         symbolP->sy_nlist.n_desc -
  919.                             Current_Line_Number,
  920.                         symbolP->sy_nlist.n_value -
  921.                             Current_Offset,
  922.                         0,
  923.                         1);
  924.                    }
  925.                 }
  926.                 /*
  927.                  *    Update the current line/PC
  928.                  */
  929.                 Current_Line_Number = symbolP->sy_nlist.n_desc;
  930.                 if (Current_Line_Number > Largest_Line_Number)
  931.                     Largest_Line_Number =
  932.                         Current_Line_Number;
  933.                 Current_Offset = symbolP->sy_nlist.n_value;
  934.                 /*
  935.                  *    Done
  936.                  */
  937.                 break;
  938.             /*
  939.              *    Source file
  940.              */
  941.             case N_SO:
  942.                 /*
  943.                  *    Remember that we had a source file
  944.                  *    and emit the source file debugger
  945.                  *    record
  946.                  */
  947.                 Has_Source_File =
  948.                     VMS_TBT_Source_File(
  949.                         symbolP->sy_nlist.n_un.n_name,
  950.                         1);
  951.                 break;
  952.           }
  953.         }
  954.        }
  955.        /*
  956.         *    If there is a routine start defined,
  957.         *    terminate it (and the line numbers)
  958.         */
  959.        if (Current_Routine) {
  960.         /*
  961.          *    Terminate the line numbers
  962.          */
  963.         VMS_TBT_Line_PC_Correlation(0,
  964.                         text_siz - Current_Routine->sy_nlist.n_value,
  965.                         0,
  966.                         -1);
  967.         /*
  968.          *    If there is a source file write out the number
  969.          *    of source lines to correlate
  970.          */
  971.         if (Has_Source_File)
  972.             VMS_TBT_Source_Lines(Largest_Line_Number);
  973.         /*
  974.          *    Terminate the routine
  975.          */
  976.         VMS_TBT_Routine_End(text_siz -
  977.                     Current_Routine->sy_nlist.n_value);
  978.        }
  979.     }
  980.     /*
  981.      *    Write the Traceback End Module TBT record
  982.      */
  983.     VMS_TBT_Module_End();
  984.  
  985.     /*
  986.      *    Write the End Of Module record
  987.      */
  988.     if (Entry_Point_Symbol == 0)
  989.         Write_VMS_EOM_Record(-1,0);
  990.     else
  991.         Write_VMS_EOM_Record(Text_Psect,
  992.                      Entry_Point_Symbol->sy_nlist.n_value);
  993.  
  994.    /*
  995.     *    All done, close the object file
  996.     */
  997.    Close_VMS_Object_File();
  998. }
  999.  
  1000.  
  1001.     /****** VMS OBJECT FILE HACKING ROUTINES *******/
  1002.  
  1003.  
  1004. /*
  1005.  *    Global data (Object records limited to 512 bytes by VAX-11 "C" runtime)
  1006.  */
  1007. static int VMS_Object_File_FD;        /* File Descriptor for object file */
  1008. static char Object_Record_Buffer[512];    /* Buffer for object file records  */
  1009. static int Object_Record_Offset;    /* Offset to end of data       */
  1010. static int Current_Object_Record_Type;    /* Type of record in above       */
  1011.  
  1012. /*
  1013.  *    Macros for placing data into the object record buffer
  1014.  */
  1015. #define    PUT_LONG(val)    *((long *)(Object_Record_Buffer + \
  1016.                   Object_Record_Offset)) = val; \
  1017.             Object_Record_Offset += sizeof(long)
  1018.  
  1019. #define    PUT_SHORT(val)    *((short *)(Object_Record_Buffer + \
  1020.                   Object_Record_Offset)) = val; \
  1021.             Object_Record_Offset += sizeof(short)
  1022.  
  1023. #define    PUT_CHAR(val)    Object_Record_Buffer[Object_Record_Offset++] = val
  1024.  
  1025. #define    PUT_COUNTED_STRING(cp) {\
  1026.             register char *p = cp; \
  1027.             PUT_CHAR(strlen(p)); \
  1028.             while(*p) PUT_CHAR(*p++);}
  1029.  
  1030. /*
  1031.  *    Macro for determining if a Name has psect attributes attached
  1032.  *    to it.
  1033.  */
  1034. #define    PSECT_ATTRIBUTES_STRING        "$$PsectAttributes_"
  1035. #define    PSECT_ATTRIBUTES_STRING_LENGTH    18
  1036.  
  1037. #define    HAS_PSECT_ATTRIBUTES(Name) \
  1038.         (strncmp((Name[0] == '_' ? Name + 1 : Name), \
  1039.          PSECT_ATTRIBUTES_STRING, \
  1040.          PSECT_ATTRIBUTES_STRING_LENGTH) == 0)
  1041.  
  1042.  
  1043. /*
  1044.  *    Create the VMS object file
  1045.  */
  1046. Create_VMS_Object_File()
  1047. {
  1048. #ifdef    eunice
  1049.     VMS_Object_File_FD = creat(out_file_name, 0777, "var");
  1050. #else    eunice
  1051.     VMS_Object_File_FD = creat(out_file_name, 0, "rfm=var");
  1052. #endif    eunice
  1053.     /*
  1054.      *    Deal with errors
  1055.      */
  1056.     if (VMS_Object_File_FD < 0) {
  1057.         char Error_Line[256];
  1058.  
  1059.         sprintf(Error_Line,"Couldn't create VMS object file \"%s\"",
  1060.                 out_file_name);
  1061.         error(Error_Line);
  1062.     }
  1063.     /*
  1064.      *    Initialize object file hacking variables
  1065.      */
  1066.     Object_Record_Offset = 0;
  1067.     Current_Object_Record_Type = -1;
  1068. }
  1069.  
  1070.  
  1071. /*
  1072.  *    Declare a particular type of object file record
  1073.  */
  1074. Set_VMS_Object_File_Record(Type)
  1075. int Type;
  1076. {
  1077.     /*
  1078.      *    If the type matches, we are done
  1079.      */
  1080.     if (Type == Current_Object_Record_Type) return;
  1081.     /*
  1082.      *    Otherwise: flush the buffer
  1083.      */
  1084.     Flush_VMS_Object_Record_Buffer();
  1085.     /*
  1086.      *    Set the new type
  1087.      */
  1088.     Current_Object_Record_Type = Type;
  1089. }
  1090.  
  1091.  
  1092. /*
  1093.  *    Flush the object record buffer to the object file
  1094.  */
  1095. Flush_VMS_Object_Record_Buffer()
  1096. {
  1097.     int i;
  1098.  
  1099.     /*
  1100.      *    If the buffer is empty, we are done
  1101.      */
  1102.     if (Object_Record_Offset == 0) return;
  1103.     /*
  1104.      *    Write the data to the file
  1105.      */
  1106.     i= write(VMS_Object_File_FD,
  1107.          Object_Record_Buffer,
  1108.          Object_Record_Offset);
  1109.     if (i != Object_Record_Offset)
  1110.         error("I/O error writing VMS object file");
  1111.     /*
  1112.      *    The buffer is now empty
  1113.      */
  1114.     Object_Record_Offset = 0;
  1115. }
  1116.  
  1117.  
  1118. /*
  1119.  *    Close the VMS Object file
  1120.  */
  1121. Close_VMS_Object_File()
  1122. {
  1123.     close(VMS_Object_File_FD);
  1124. }
  1125.  
  1126.  
  1127. /*
  1128.  *    Write the MHD (Module Header) records
  1129.  */
  1130. Write_VMS_MHD_Records()
  1131. {
  1132.     register char *cp,*cp1;
  1133.     register int i;
  1134.     struct {int Size; char *Ptr;} Descriptor;
  1135.     char Module_Name[256];
  1136.     char Now[17];
  1137.  
  1138.     /*
  1139.      *    We are writing a module header record
  1140.      */
  1141.     Set_VMS_Object_File_Record(OBJ$C_HDR);
  1142.     /*
  1143.      *    ***************************
  1144.      *    *MAIN MODULE HEADER RECORD*
  1145.      *    ***************************
  1146.      *
  1147.      *    Store record type and header type
  1148.      */
  1149.     PUT_CHAR(OBJ$C_HDR);
  1150.     PUT_CHAR(MHD$C_MHD);
  1151.     /*
  1152.      *    Structure level is 0
  1153.      */
  1154.     PUT_CHAR(OBJ$C_STRLVL);
  1155.     /*
  1156.      *    Maximum record size is size of the object record buffer
  1157.      */
  1158.     PUT_SHORT(sizeof(Object_Record_Buffer));
  1159.     /*
  1160.      *    Get module name (the FILENAME part of the object file)
  1161.      */
  1162.     cp = out_file_name;
  1163.     cp1 = Module_Name;
  1164.     while(*cp) {
  1165.         if ((*cp == ']') || (*cp == '>') ||
  1166.             (*cp == ':') || (*cp == '/')) {
  1167.             cp1 = Module_Name;
  1168.             cp++;
  1169.             continue;
  1170.         }
  1171.         *cp1++ = islower(*cp) ? toupper(*cp++) : *cp++;
  1172.     }
  1173.     *cp1 = 0;
  1174.     /*
  1175.      *    Limit it to 31 characters and store in the object record
  1176.      */
  1177.     while(--cp1 >= Module_Name)
  1178.         if (*cp1 == '.') *cp1 = 0;
  1179.     if (strlen(Module_Name) > 31) Module_Name[31] = 0;
  1180.     PUT_COUNTED_STRING(Module_Name);
  1181.     /*
  1182.      *    Module Version is "V1.0"
  1183.      */
  1184.     PUT_COUNTED_STRING("V1.0");
  1185.     /*
  1186.      *    Creation time is "now" (17 chars of time string)
  1187.      */
  1188.     Descriptor.Size = 17;
  1189.     Descriptor.Ptr = Now;
  1190.     sys$asctim(0,&Descriptor,0,0);
  1191.     for(i = 0; i < 17; i++) PUT_CHAR(Now[i]);
  1192.     /*
  1193.      *    Patch time is "never" (17 zeros)
  1194.      */
  1195.     for(i = 0; i < 17; i++) PUT_CHAR(0);
  1196.     /*
  1197.      *    Flush the record
  1198.      */
  1199.     Flush_VMS_Object_Record_Buffer();
  1200.     /*
  1201.      *    *************************
  1202.      *    *LANGUAGE PROCESSOR NAME*
  1203.      *    *************************
  1204.      *
  1205.      *    Store record type and header type
  1206.      */
  1207.     PUT_CHAR(OBJ$C_HDR);
  1208.     PUT_CHAR(MHD$C_LNM);
  1209.     /*
  1210.      *    Store language processor name and version
  1211.      *    (not a counted string!)
  1212.      */
  1213.     cp = compiler_version_string;
  1214.     if (cp == 0) cp ="GNU AS  V1.0";
  1215.     while(*cp) PUT_CHAR(*cp++);
  1216.     /*
  1217.      *    Flush the record
  1218.      */
  1219.     Flush_VMS_Object_Record_Buffer();
  1220. }
  1221.  
  1222.  
  1223. /*
  1224.  *    Write the EOM (End Of Module) record
  1225.  */
  1226. Write_VMS_EOM_Record(Psect, Offset)
  1227. int Psect;
  1228. int Offset;
  1229. {
  1230.     /*
  1231.      *    We are writing an end-of-module record
  1232.      */
  1233.     Set_VMS_Object_File_Record(OBJ$C_EOM);
  1234.     /*
  1235.      *    Store record Type
  1236.      */
  1237.     PUT_CHAR(OBJ$C_EOM);
  1238.     /*
  1239.      *    Store the error severity (0)
  1240.      */
  1241.     PUT_CHAR(0);
  1242.     /*
  1243.      *    Store the entry point, if it exists
  1244.      */
  1245.     if (Psect >= 0) {
  1246.         /*
  1247.          *    Store the entry point Psect
  1248.          */
  1249.         PUT_CHAR(Psect);
  1250.         /*
  1251.          *    Store the entry point Psect offset
  1252.          */
  1253.         PUT_LONG(Offset);
  1254.     }
  1255.     /*
  1256.      *    Flush the record
  1257.      */
  1258.     Flush_VMS_Object_Record_Buffer();
  1259. }
  1260.  
  1261.  
  1262. /*
  1263.  *    Generate a Case-Hacked VMS symbol name (limited to 31 chars)
  1264.  */
  1265. VMS_Case_Hack_Symbol(In,Out)
  1266. register char *In;
  1267. register char *Out;
  1268. {
  1269.     register int i;
  1270.     int Case_Hack_Bits = 0;
  1271.     int Saw_Dollar = 0;
  1272.     static char Hex_Table[16] =
  1273.      {'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'};
  1274.  
  1275.     /*
  1276.      *    Kill any leading "_"
  1277.      */
  1278.     if (*In == '_') In++;
  1279.     /*
  1280.      *    Is there a Psect Attribute to skip??
  1281.      */
  1282.     if (HAS_PSECT_ATTRIBUTES(In)) {
  1283.         /*
  1284.          *    Yes: Skip it
  1285.          */
  1286.         In += PSECT_ATTRIBUTES_STRING_LENGTH;
  1287.         while(*In) {
  1288.             if ((In[0] == '$') && (In[1] == '$')) {
  1289.                 In += 2;
  1290.                 break;
  1291.             }
  1292.             In++;
  1293.         }
  1294.     }
  1295.     /*
  1296.      *    Do the case conversion
  1297.      */
  1298.     i = 23;    /* Maximum of 23 chars */
  1299.     while(*In && (--i >= 0)) {
  1300.         Case_Hack_Bits <<= 1;
  1301.         if (*In == '$') Saw_Dollar = 1;
  1302.         if (isupper(*In)) {
  1303.             *Out++ = *In++;
  1304.             Case_Hack_Bits |= 1;
  1305.         } else {
  1306.             *Out++ = islower(*In) ? toupper(*In++) : *In++;
  1307.         }
  1308.     }
  1309.     /*
  1310.      *    If we saw a dollar sign, we don't do case hacking
  1311.      */
  1312.     if (Saw_Dollar) Case_Hack_Bits = 0;
  1313.     /*
  1314.      *    If we have more than 23 characters and everything is lowercase
  1315.      *    we can insert the full 31 characters
  1316.      */
  1317.     if (*In) {
  1318.         /*
  1319.          *    We  have more than 23 characters
  1320.          */
  1321.         if (Case_Hack_Bits == 0) {
  1322.             /*
  1323.              *    And so far they are all lower case:
  1324.              *        Check up to 8 more characters
  1325.              *        and ensure that they are lowercase
  1326.              */
  1327.             for(i = 0; (In[i] != 0) && (i < 8); i++)
  1328.                 if (isupper(In[i]) && !Saw_Dollar) break;
  1329.             if ((i >= 8) || (In[i] == 0)) {
  1330.                 /*
  1331.                  *    They are:  Copy up to 31 characters
  1332.                  *            to the output string
  1333.                  */
  1334.                 i = 8;
  1335.                 while((--i >= 0) && (*In))
  1336.                     *Out++ = islower(*In) ?
  1337.                             toupper(*In++) :
  1338.                             *In++;
  1339.             }
  1340.         }
  1341.     }
  1342.     /*
  1343.      *    If there were any uppercase characters in the name we
  1344.      *    take on the case hacking string
  1345.      */
  1346.     if (Case_Hack_Bits != 0) {
  1347.         *Out++ = '_';
  1348.         for(i = 0; i < 6; i++) {
  1349.             *Out++ = Hex_Table[Case_Hack_Bits & 0xf];
  1350.             Case_Hack_Bits >>= 4;
  1351.         }
  1352.         *Out++ = 'X';
  1353.     }
  1354.     /*
  1355.      *    Done
  1356.      */
  1357.     *Out = 0;
  1358. }
  1359.  
  1360.  
  1361. /*
  1362.  *    Scan a symbol name for a psect attribute specification
  1363.  */
  1364. VMS_Modify_Psect_Attributes(Name, Attribute_Pointer)
  1365. char *Name;
  1366. int *Attribute_Pointer;
  1367. {
  1368.     register int i;
  1369.     register char *cp;
  1370.     int Negate;
  1371.     static struct {
  1372.         char *Name;
  1373.         int   Value;
  1374.         } Attributes[] = {
  1375.         {"PIC",        GPS$M_PIC},
  1376.         {"LIB",        GPS$M_LIB},
  1377.         {"OVR",        GPS$M_OVR},
  1378.         {"REL",        GPS$M_REL},
  1379.         {"GBL",        GPS$M_GBL},
  1380.         {"SHR",        GPS$M_SHR},
  1381.         {"EXE",        GPS$M_EXE},
  1382.         {"RD",        GPS$M_RD},
  1383.         {"WRT",        GPS$M_WRT},
  1384.         {"VEC",        GPS$M_VEC},
  1385.         {0,        0}};
  1386.  
  1387.     /*
  1388.      *    Kill leading "_"
  1389.      */
  1390.     if (*Name == '_') Name++;
  1391.     /*
  1392.      *    Check for a PSECT attribute list
  1393.      */
  1394.     if (!HAS_PSECT_ATTRIBUTES(Name)) return;    /* If not, return */
  1395.     /*
  1396.      *    Skip the attribute list indicator
  1397.      */
  1398.     Name += PSECT_ATTRIBUTES_STRING_LENGTH;
  1399.     /*
  1400.      *    Process the attributes ("_" separated, "$" terminated)
  1401.      */
  1402.     while(*Name != '$') {
  1403.         /*
  1404.          *    Assume not negating
  1405.          */
  1406.         Negate = 0;
  1407.         /*
  1408.          *    Check for "NO"
  1409.          */
  1410.         if ((Name[0] == 'N') && (Name[1] == 'O')) {
  1411.             /*
  1412.              *    We are negating (and skip the NO)
  1413.              */
  1414.             Negate = 1;
  1415.             Name += 2;
  1416.         }
  1417.         /*
  1418.          *    Find the token delimiter
  1419.          */
  1420.         cp = Name;
  1421.         while(*cp && (*cp != '_') && (*cp != '$')) cp++;
  1422.         /*
  1423.          *    Look for the token in the attribute list
  1424.          */
  1425.         for(i = 0; Attributes[i].Name; i++) {
  1426.             /*
  1427.              *    If the strings match, set/clear the attr.
  1428.              */
  1429.             if (strncmp(Name, Attributes[i].Name, cp - Name) == 0) {
  1430.                 /*
  1431.                  *    Set or clear
  1432.                  */
  1433.                 if (Negate)
  1434.                     *Attribute_Pointer &=
  1435.                         ~Attributes[i].Value;
  1436.                 else
  1437.                     *Attribute_Pointer |=
  1438.                          Attributes[i].Value;
  1439.                 /*
  1440.                  *    Done
  1441.                  */
  1442.                 break;
  1443.             }
  1444.         }
  1445.         /*
  1446.          *    Now skip the attribute
  1447.          */
  1448.         Name = cp;
  1449.         if (*Name == '_') Name++;
  1450.     }
  1451.     /*
  1452.      *    Done
  1453.      */
  1454.     return;
  1455. }
  1456.  
  1457.  
  1458. /*
  1459.  *    Define a psect
  1460.  */
  1461. VMS_Psect_Spec(Name, Size, Type)
  1462. char *Name;
  1463. int Size;
  1464. char *Type;
  1465. {
  1466.     char Local[32];
  1467.     int Psect_Attributes;
  1468.  
  1469.     /*
  1470.      *    We are writing a GSD record
  1471.      */
  1472.     Set_VMS_Object_File_Record(OBJ$C_GSD);
  1473.     /*
  1474.      *    If the buffer is empty we must insert the GSD record type
  1475.      */
  1476.     if (Object_Record_Offset == 0) PUT_CHAR(OBJ$C_GSD);
  1477.     /*
  1478.      *    We are writing a PSECT definition subrecord
  1479.      */
  1480.     PUT_CHAR(GSD$C_PSC);
  1481.     /*
  1482.      *    Psects are always LONGWORD aligned
  1483.      */
  1484.     PUT_CHAR(2);
  1485.     /*
  1486.      *    Generate the appropriate PSECT flags given the PSECT type
  1487.      */
  1488.     if (strcmp(Type,"COMMON") == 0) {
  1489.         /*
  1490.          *    Common block psects are:  PIC,OVR,REL,GBL,SHR,RD,WRT
  1491.          */
  1492.         Psect_Attributes = (GPS$M_PIC|GPS$M_OVR|GPS$M_REL|GPS$M_GBL|
  1493.                       GPS$M_SHR|GPS$M_RD|GPS$M_WRT);
  1494.     } else {
  1495.         if (strcmp(Type,"DATA") == 0) {
  1496.             /*
  1497.              *    The Data psects are PIC,REL,RD,WRT
  1498.              */
  1499.             Psect_Attributes =
  1500.                 (GPS$M_PIC|GPS$M_REL|GPS$M_RD|GPS$M_WRT);
  1501.         } else {
  1502.             if (strcmp(Type,"TEXT") == 0) {
  1503.                 /*
  1504.                  *    The Text psects are PIC,REL,SHR,EXE,RD
  1505.                  */
  1506.                 Psect_Attributes =
  1507.                     (GPS$M_PIC|GPS$M_REL|GPS$M_SHR|
  1508.                               GPS$M_EXE|GPS$M_RD);
  1509.             } else {
  1510.                 /*
  1511.                  *    Error: Unknown psect type
  1512.                  */
  1513.                 error("Unknown VMS psect type");
  1514.             }
  1515.         }
  1516.     }
  1517.     /*
  1518.      *    Modify the psect attributes according to any attribute string
  1519.      */
  1520.     if (HAS_PSECT_ATTRIBUTES(Name))
  1521.         VMS_Modify_Psect_Attributes(Name,&Psect_Attributes);
  1522.     /*
  1523.      *    Specify the psect attributes
  1524.      */
  1525.     PUT_SHORT(Psect_Attributes);
  1526.     /*
  1527.      *    Specify the allocation
  1528.      */
  1529.     PUT_LONG(Size);
  1530.     /*
  1531.      *    Finally, the psect name
  1532.      */
  1533.     VMS_Case_Hack_Symbol(Name,Local);
  1534.     PUT_COUNTED_STRING(Local);
  1535.     /*
  1536.      *    Flush the buffer if it is more than 75% full
  1537.      */
  1538.     if (Object_Record_Offset >
  1539.         (sizeof(Object_Record_Buffer)*3/4))
  1540.             Flush_VMS_Object_Record_Buffer();
  1541. }
  1542.  
  1543.  
  1544. /*
  1545.  *    Define a global symbol
  1546.  */
  1547. VMS_Global_Symbol_Spec(Name, Psect_Number, Psect_Offset, Defined)
  1548. char *Name;
  1549. int Psect_Number;
  1550. int Psect_Offset;
  1551. {
  1552.     char Local[32];
  1553.  
  1554.     /*
  1555.      *    We are writing a GSD record
  1556.      */
  1557.     Set_VMS_Object_File_Record(OBJ$C_GSD);
  1558.     /*
  1559.      *    If the buffer is empty we must insert the GSD record type
  1560.      */
  1561.     if (Object_Record_Offset == 0) PUT_CHAR(OBJ$C_GSD);
  1562.     /*
  1563.      *    We are writing a Global symbol definition subrecord
  1564.      */
  1565.     if (Psect_Number <= 255) {
  1566.         PUT_CHAR(GSD$C_SYM);
  1567.     } else {
  1568.         PUT_CHAR(GSD$C_SYMW);
  1569.     }
  1570.     /*
  1571.      *    Data type is undefined
  1572.      */
  1573.     PUT_CHAR(0);
  1574.     /*
  1575.      *    Switch on Definition/Reference
  1576.      */
  1577.     if (Defined) {
  1578.         /*
  1579.          *    Definition:
  1580.          *    Flags = "RELOCATABLE" and "DEFINED"
  1581.          */
  1582.         PUT_SHORT(GSY$M_DEF|GSY$M_REL);
  1583.         /*
  1584.          *    Psect Number
  1585.          */
  1586.         if (Psect_Number <= 255) {
  1587.             PUT_CHAR(Psect_Number);
  1588.         } else {
  1589.             PUT_SHORT(Psect_Number);
  1590.         }
  1591.         /*
  1592.          *    Offset
  1593.          */
  1594.         PUT_LONG(Psect_Offset);
  1595.     } else {
  1596.         /*
  1597.          *    Reference:
  1598.          *    Flags = "RELOCATABLE"
  1599.          */
  1600.         PUT_SHORT(GSY$M_REL);
  1601.     }
  1602.     /*
  1603.      *    Finally, the global symbol name
  1604.      */
  1605.     VMS_Case_Hack_Symbol(Name,Local);
  1606.     PUT_COUNTED_STRING(Local);
  1607.     /*
  1608.      *    Flush the buffer if it is more than 75% full
  1609.      */
  1610.     if (Object_Record_Offset >
  1611.         (sizeof(Object_Record_Buffer)*3/4))
  1612.             Flush_VMS_Object_Record_Buffer();
  1613. }
  1614.  
  1615.  
  1616. /*
  1617.  *    Define a procedure entry pt/mask
  1618.  */
  1619. VMS_Procedure_Entry_Pt(Name, Psect_Number, Psect_Offset, Entry_Mask)
  1620. char *Name;
  1621. int Psect_Number;
  1622. int Psect_Offset;
  1623. int Entry_Mask;
  1624. {
  1625.     char Local[32];
  1626.  
  1627.     /*
  1628.      *    We are writing a GSD record
  1629.      */
  1630.     Set_VMS_Object_File_Record(OBJ$C_GSD);
  1631.     /*
  1632.      *    If the buffer is empty we must insert the GSD record type
  1633.      */
  1634.     if (Object_Record_Offset == 0) PUT_CHAR(OBJ$C_GSD);
  1635.     /*
  1636.      *    We are writing a Procedure Entry Pt/Mask subrecord
  1637.      */
  1638.     if (Psect_Number <= 255) {
  1639.         PUT_CHAR(GSD$C_EPM);
  1640.     } else {
  1641.         PUT_CHAR(GSD$C_EPMW);
  1642.     }
  1643.     /*
  1644.      *    Data type is undefined
  1645.      */
  1646.     PUT_CHAR(0);
  1647.     /*
  1648.      *    Flags = "RELOCATABLE" and "DEFINED"
  1649.      */
  1650.     PUT_SHORT(GSY$M_DEF|GSY$M_REL);
  1651.     /*
  1652.      *    Psect Number
  1653.      */
  1654.     if (Psect_Number <= 255) {
  1655.         PUT_CHAR(Psect_Number);
  1656.     } else {
  1657.         PUT_SHORT(Psect_Number);
  1658.     }
  1659.     /*
  1660.      *    Offset
  1661.      */
  1662.     PUT_LONG(Psect_Offset);
  1663.     /*
  1664.      *    Entry mask
  1665.      */
  1666.     PUT_SHORT(Entry_Mask);
  1667.     /*
  1668.      *    Finally, the global symbol name
  1669.      */
  1670.     VMS_Case_Hack_Symbol(Name,Local);
  1671.     PUT_COUNTED_STRING(Local);
  1672.     /*
  1673.      *    Flush the buffer if it is more than 75% full
  1674.      */
  1675.     if (Object_Record_Offset >
  1676.         (sizeof(Object_Record_Buffer)*3/4))
  1677.             Flush_VMS_Object_Record_Buffer();
  1678. }
  1679.  
  1680.  
  1681. /*
  1682.  *    Set the current location counter to a particular Psect and Offset
  1683.  */
  1684. VMS_Set_Psect(Psect_Index, Offset, Record_Type)
  1685. int Psect_Index;
  1686. int Offset;
  1687. int Record_Type;
  1688. {
  1689.     /*
  1690.      *    We are writing a "Record_Type" record
  1691.      */
  1692.     Set_VMS_Object_File_Record(Record_Type);
  1693.     /*
  1694.      *    If the buffer is empty we must insert the record type
  1695.      */
  1696.     if (Object_Record_Offset == 0) PUT_CHAR(Record_Type);
  1697.     /*
  1698.      *    Stack the Psect base + Longword Offset
  1699.      */
  1700.     if (Psect_Index < 255) {
  1701.         PUT_CHAR(TIR$C_STA_PL);
  1702.         PUT_CHAR(Psect_Index);
  1703.     } else {
  1704.         PUT_CHAR(TIR$C_STA_WPL);
  1705.         PUT_SHORT(Psect_Index);
  1706.     }
  1707.     PUT_LONG(Offset);
  1708.     /*
  1709.      *    Set relocation base
  1710.      */
  1711.     PUT_CHAR(TIR$C_CTL_SETRB);
  1712.     /*
  1713.      *    Flush the buffer if it is more than 75% full
  1714.      */
  1715.     if (Object_Record_Offset >
  1716.         (sizeof(Object_Record_Buffer)*3/4))
  1717.             Flush_VMS_Object_Record_Buffer();
  1718. }
  1719.  
  1720.  
  1721. /*
  1722.  *    Store immediate data in current Psect
  1723.  */
  1724. VMS_Store_Immediate_Data(Pointer, Size, Record_Type)
  1725. register char *Pointer;
  1726. int Size;
  1727. int Record_Type;
  1728. {
  1729.     register int i;
  1730.  
  1731.     /*
  1732.      *    We are writing a "Record_Type" record
  1733.      */
  1734.     Set_VMS_Object_File_Record(Record_Type);
  1735.     /*
  1736.      *    We can only store 128 bytes at a time
  1737.      */
  1738.     while(Size > 0) {
  1739.         /*
  1740.          *    Store a maximum of 128 bytes
  1741.          */
  1742.         i = (Size > 128) ? 128 : Size;
  1743.         Size -= i;
  1744.         /*
  1745.          *    If we cannot accommodate this record, flush the
  1746.          *    buffer.
  1747.          */
  1748.         if ((Object_Record_Offset + i + 1) >=
  1749.                     sizeof(Object_Record_Buffer))
  1750.             Flush_VMS_Object_Record_Buffer();
  1751.         /*
  1752.          *    If the buffer is empty we must insert record type
  1753.          */
  1754.         if (Object_Record_Offset == 0) PUT_CHAR(Record_Type);
  1755.         /*
  1756.          *    Store the count
  1757.          */
  1758.         PUT_CHAR(-i & 0xff);
  1759.         /*
  1760.          *    Store the data
  1761.          */
  1762.         while(--i >= 0) PUT_CHAR(*Pointer++);
  1763.         /*
  1764.          *    Flush the buffer if it is more than 75% full
  1765.          */
  1766.         if (Object_Record_Offset >
  1767.             (sizeof(Object_Record_Buffer)*3/4))
  1768.                 Flush_VMS_Object_Record_Buffer();
  1769.     }
  1770. }
  1771.  
  1772.  
  1773. /*
  1774.  *    Store repeated immediate data in current Psect
  1775.  */
  1776. VMS_Store_Repeated_Data(Repeat_Count,Pointer, Size, Record_Type)
  1777. int Repeat_Count;
  1778. register char *Pointer;
  1779. int Size;
  1780. int Record_Type;
  1781. {
  1782.  
  1783.     /*
  1784.      *    Ignore zero bytes/words/longwords
  1785.      */
  1786.     if ((Size == sizeof(char)) && (*Pointer == 0)) return;
  1787.     if ((Size == sizeof(short)) && (*(short *)Pointer == 0)) return;
  1788.     if ((Size == sizeof(long)) && (*(long *)Pointer == 0)) return;
  1789.     /*
  1790.      *    If the data is too big for a TIR$C_STO_RIVB sub-record
  1791.      *    then we do it manually
  1792.      */
  1793.     if (Size > 255) {
  1794.         while(--Repeat_Count >= 0)
  1795.             VMS_Store_Immediate_Data(Pointer,Size,Record_Type);
  1796.         return;
  1797.     }
  1798.     /*
  1799.      *    We are writing a "Record_Type" record
  1800.      */
  1801.     Set_VMS_Object_File_Record(Record_Type);
  1802.     /*
  1803.      *    If the buffer is empty we must insert record type
  1804.      */
  1805.     if (Object_Record_Offset == 0) PUT_CHAR(Record_Type);
  1806.     /*
  1807.      *    Stack the repeat count
  1808.      */
  1809.     PUT_CHAR(TIR$C_STA_LW);
  1810.     PUT_LONG(Repeat_Count);
  1811.     /*
  1812.      *    And now the command and its data
  1813.      */
  1814.     PUT_CHAR(TIR$C_STO_RIVB);
  1815.     PUT_CHAR(Size);
  1816.     while(--Size >= 0) PUT_CHAR(*Pointer++);
  1817.     /*
  1818.      *    Flush the buffer if it is more than 75% full
  1819.      */
  1820.     if (Object_Record_Offset >
  1821.         (sizeof(Object_Record_Buffer)*3/4))
  1822.             Flush_VMS_Object_Record_Buffer();
  1823. }
  1824.  
  1825.  
  1826. /*
  1827.  *    Store a Position Independent Reference
  1828.  */
  1829. VMS_Store_PIC_Symbol_Reference(Symbol, Offset, PC_Relative,
  1830.                     Psect, Psect_Offset, Record_Type)
  1831. struct symbol *Symbol;
  1832. int Offset;
  1833. int PC_Relative;
  1834. int Psect;
  1835. int Psect_Offset;
  1836. int Record_Type;
  1837. {
  1838.     register struct VMS_Symbol *vsp =
  1839.         (struct VMS_Symbol *)(Symbol->sy_number);
  1840.     char Local[32];
  1841.  
  1842.     /*
  1843.      *    We are writing a "Record_Type" record
  1844.      */
  1845.     Set_VMS_Object_File_Record(Record_Type);
  1846.     /*
  1847.      *    If the buffer is empty we must insert record type
  1848.      */
  1849.     if (Object_Record_Offset == 0) PUT_CHAR(Record_Type);
  1850.     /*
  1851.      *    Set to the appropriate offset in the Psect
  1852.      */
  1853.     if (PC_Relative) {
  1854.         /*
  1855.          *    For a Code reference we need to fix the operand
  1856.          *    specifier as well (so back up 1 byte)
  1857.          */
  1858.         VMS_Set_Psect(Psect, Psect_Offset - 1, Record_Type);
  1859.     } else {
  1860.         /*
  1861.          *    For a Data reference we just store HERE
  1862.          */
  1863.         VMS_Set_Psect(Psect, Psect_Offset, Record_Type);
  1864.     }
  1865.     /*
  1866.      *    Make sure we are still generating a "Record Type" record
  1867.      */
  1868.     if (Object_Record_Offset == 0) PUT_CHAR(Record_Type);
  1869.     /*
  1870.      *    Dispatch on symbol type (so we can stack its value)
  1871.      */
  1872.     switch(Symbol->sy_nlist.n_type) {
  1873.         /*
  1874.          *    Global symbol
  1875.          */
  1876. #ifdef    NOT_VAX_11_C_COMPATIBLE
  1877.         case N_UNDF | N_EXT:
  1878.         case N_DATA | N_EXT:
  1879. #endif    NOT_VAX_11_C_COMPATIBLE
  1880.         case N_UNDF:
  1881.         case N_TEXT | N_EXT:
  1882.             /*
  1883.              *    Get the symbol name (case hacked)
  1884.              */
  1885.             VMS_Case_Hack_Symbol(Symbol->sy_nlist.n_un.n_name,Local);
  1886.             /*
  1887.              *    Stack the global symbol value
  1888.              */
  1889.             PUT_CHAR(TIR$C_STA_GBL);
  1890.             PUT_COUNTED_STRING(Local);
  1891.             if (Offset) {
  1892.                 /*
  1893.                  *    Stack the longword offset
  1894.                  */
  1895.                 PUT_CHAR(TIR$C_STA_LW);
  1896.                 PUT_LONG(Offset);
  1897.                 /*
  1898.                  *    Add the two, leaving the result on the stack
  1899.                  */
  1900.                 PUT_CHAR(TIR$C_OPR_ADD);
  1901.             }
  1902.             break;
  1903.         /*
  1904.          *    Uninitialized local data
  1905.          */
  1906.         case N_BSS:
  1907.             /*
  1908.              *    Stack the Psect (+offset)
  1909.              */
  1910.             if (vsp->Psect_Index < 255) {
  1911.                 PUT_CHAR(TIR$C_STA_PL);
  1912.                 PUT_CHAR(vsp->Psect_Index);
  1913.             } else {
  1914.                 PUT_CHAR(TIR$C_STA_WPL);
  1915.                 PUT_SHORT(vsp->Psect_Index);
  1916.             }
  1917.             PUT_LONG(vsp->Psect_Offset + Offset);
  1918.             break;
  1919.         /*
  1920.          *    Local text
  1921.          */
  1922.         case N_TEXT:
  1923.             /*
  1924.              *    Stack the Psect (+offset)
  1925.              */
  1926.             if (vsp->Psect_Index < 255) {
  1927.                 PUT_CHAR(TIR$C_STA_PL);
  1928.                 PUT_CHAR(vsp->Psect_Index);
  1929.             } else {
  1930.                 PUT_CHAR(TIR$C_STA_WPL);
  1931.                 PUT_SHORT(vsp->Psect_Index);
  1932.             }
  1933.             PUT_LONG(Symbol->sy_nlist.n_value);
  1934.             break;
  1935.         /*
  1936.          *    Initialized local or global data
  1937.          */
  1938.         case N_DATA:
  1939. #ifndef    NOT_VAX_11_C_COMPATIBLE
  1940.         case N_UNDF | N_EXT:
  1941.         case N_DATA | N_EXT:
  1942. #endif    NOT_VAX_11_C_COMPATIBLE
  1943.             /*
  1944.              *    Stack the Psect (+offset)
  1945.              */
  1946.             if (vsp->Psect_Index < 255) {
  1947.                 PUT_CHAR(TIR$C_STA_PL);
  1948.                 PUT_CHAR(vsp->Psect_Index);
  1949.             } else {
  1950.                 PUT_CHAR(TIR$C_STA_WPL);
  1951.                 PUT_SHORT(vsp->Psect_Index);
  1952.             }
  1953.             PUT_LONG(vsp->Psect_Offset + Offset);
  1954.             break;
  1955.     }
  1956.     /*
  1957.      *    Store either a code or data reference
  1958.      */
  1959.     PUT_CHAR(PC_Relative ? TIR$C_STO_PICR : TIR$C_STO_PIDR);
  1960.     /*
  1961.      *    Flush the buffer if it is more than 75% full
  1962.      */
  1963.     if (Object_Record_Offset >
  1964.         (sizeof(Object_Record_Buffer)*3/4))
  1965.             Flush_VMS_Object_Record_Buffer();
  1966. }
  1967.  
  1968.  
  1969. /*
  1970.  *    Check in the text area for an indirect pc-relative reference
  1971.  *    and fix it up with addressing mode 0xff [PC indirect]
  1972.  *
  1973.  *    THIS SHOULD BE REPLACED BY THE USE OF TIR$C_STO_PIRR IN THE
  1974.  *    PIC CODE GENERATING FIXUP ROUTINE.
  1975.  */
  1976. VMS_Fix_Indirect_Reference(Text_Psect, Offset, fragP, text_frag_root)
  1977. int Text_Psect;
  1978. int Offset;
  1979. register fragS *fragP;
  1980. struct frag *text_frag_root;
  1981. {
  1982.     /*
  1983.      *    The addressing mode byte is 1 byte before the address
  1984.      */
  1985.     Offset--;
  1986.     /*
  1987.      *    Is it in THIS frag??
  1988.      */
  1989.     if ((Offset < fragP->fr_address) ||
  1990.         (Offset >= (fragP->fr_address + fragP->fr_fix))) {
  1991.         /*
  1992.          *    We need to search for the fragment containing this
  1993.          *    Offset
  1994.          */
  1995.         for(fragP = text_frag_root; fragP; fragP = fragP->fr_next) {
  1996.             if ((Offset >= fragP->fr_address) &&
  1997.                 (Offset < (fragP->fr_address + fragP->fr_fix)))
  1998.                 break;
  1999.         }
  2000.         /*
  2001.          *    If we couldn't find the frag, things are BAD!!
  2002.          */
  2003.         if (fragP == 0)
  2004.             error("Couldn't find fixup fragment when checking for indirect reference");
  2005.     }
  2006.     /*
  2007.      *    Check for indirect PC relative addressing mode
  2008.      */
  2009.     if (fragP->fr_literal[Offset - fragP->fr_address] == (char)0xff) {
  2010.         static char Address_Mode = 0xff;
  2011.  
  2012.         /*
  2013.          *    Yes: Store the indirect mode back into the image
  2014.          *         to fix up the damage done by STO_PICR
  2015.          */
  2016.         VMS_Set_Psect(Text_Psect,Offset,OBJ$C_TIR);
  2017.         VMS_Store_Immediate_Data(&Address_Mode,1,OBJ$C_TIR);
  2018.     }
  2019. }
  2020.  
  2021.  
  2022. /*
  2023.  *    Write the Traceback Module Begin record
  2024.  */
  2025. VMS_TBT_Module_Begin()
  2026. {
  2027.     register char *cp,*cp1;
  2028.     int Size;
  2029.     char Module_Name[256];
  2030.     char Local[256];
  2031.  
  2032.     /*
  2033.      *    Get module name (the FILENAME part of the object file)
  2034.      */
  2035.     cp = out_file_name;
  2036.     cp1 = Module_Name;
  2037.     while(*cp) {
  2038.         if ((*cp == ']') || (*cp == '>') ||
  2039.             (*cp == ':') || (*cp == '/')) {
  2040.             cp1 = Module_Name;
  2041.             cp++;
  2042.             continue;
  2043.         }
  2044.         *cp1++ = islower(*cp) ? toupper(*cp++) : *cp++;
  2045.     }
  2046.     *cp1 = 0;
  2047.     /*
  2048.      *    Limit it to 31 characters
  2049.      */
  2050.     while(--cp1 >= Module_Name)
  2051.         if (*cp1 == '.') *cp1 = 0;
  2052.     if (strlen(Module_Name) > 31) Module_Name[31] = 0;
  2053.     /*
  2054.      *    Arrange to store the data locally (leave room for size byte)
  2055.      */
  2056.     cp = Local+1;
  2057.     /*
  2058.      *    Begin module
  2059.      */
  2060.     *cp++ = DST$C_MODBEG;
  2061.     /*
  2062.      *    Unused
  2063.      */
  2064.     *cp++ = 0;
  2065.     /*
  2066.      *    Language type == "C"
  2067.      */
  2068.     *(long *)cp = DST$C_C;
  2069.     cp += sizeof(long);
  2070.     /*
  2071.      *    Store the module name
  2072.      */
  2073.     *cp++ = strlen(Module_Name);
  2074.     cp1 = Module_Name;
  2075.     while(*cp1) *cp++ = *cp1++;
  2076.     /*
  2077.      *    Now we can store the record size
  2078.      */
  2079.     Size = (cp - Local);
  2080.     Local[0] = Size-1;
  2081.     /*
  2082.      *    Put it into the object record
  2083.      */
  2084.     VMS_Store_Immediate_Data(Local, Size, OBJ$C_TBT);
  2085. }
  2086.  
  2087.  
  2088. /*
  2089.  *    Write the Traceback Module End record
  2090.  */
  2091. VMS_TBT_Module_End()
  2092. {
  2093.     char Local[2];
  2094.  
  2095.     /*
  2096.      *    End module
  2097.      */
  2098.     Local[0] = 1;
  2099.     Local[1] = DST$C_MODEND;
  2100.     /*
  2101.      *    Put it into the object record
  2102.      */
  2103.     VMS_Store_Immediate_Data(Local, 2, OBJ$C_TBT);
  2104. }
  2105.  
  2106.  
  2107. /*
  2108.  *    Write the Traceback Routine Begin record
  2109.  */
  2110. VMS_TBT_Routine_Begin(symbolP, Psect)
  2111. struct symbol *symbolP;
  2112. int Psect;
  2113. {
  2114.     register char *cp,*cp1;
  2115.     char *Name;
  2116.     int Offset;
  2117.     int Size;
  2118.     char Local[512];
  2119.  
  2120.     /*
  2121.      *    Strip the leading "_" from the name
  2122.      */
  2123.     Name = symbolP->sy_nlist.n_un.n_name;
  2124.     if (*Name == '_') Name++;
  2125.     /*
  2126.      *    Get the text psect offset
  2127.      */
  2128.     Offset = symbolP->sy_nlist.n_value;
  2129.     /*
  2130.      *    Calculate the record size
  2131.      */
  2132.     Size = 1+1+4+1+strlen(Name);
  2133.     /*
  2134.      *    Record Size
  2135.      */
  2136.     Local[0] = Size;
  2137.     /*
  2138.      *    Begin Routine
  2139.      */
  2140.     Local[1] = DST$C_RTNBEG;
  2141.     /*
  2142.      *    Uses CallS/CallG
  2143.      */
  2144.     Local[2] = 0;
  2145.     /*
  2146.      *    Store the data so far
  2147.      */
  2148.     VMS_Store_Immediate_Data(Local, 3, OBJ$C_TBT);
  2149.     /*
  2150.      *    Make sure we are still generating a OBJ$C_TBT record
  2151.      */
  2152.     if (Object_Record_Offset == 0) PUT_CHAR(OBJ$C_TBT);
  2153.     /*
  2154.      *    Now get the symbol address
  2155.      */
  2156.     PUT_CHAR(TIR$C_STA_WPL);
  2157.     PUT_SHORT(Psect);
  2158.     PUT_LONG(Offset);
  2159.     /*
  2160.      *    Store the data reference
  2161.      */
  2162.     PUT_CHAR(TIR$C_STO_PIDR);
  2163.     /*
  2164.      *    Store the counted string as data
  2165.      */
  2166.     cp = Local;
  2167.     cp1 = Name;
  2168.     Size = strlen(cp1) + 1;
  2169.     *cp++ = Size - 1;
  2170.     while(*cp1) *cp++ = *cp1++;
  2171.     VMS_Store_Immediate_Data(Local, Size, OBJ$C_TBT);
  2172. }
  2173.  
  2174.  
  2175. /*
  2176.  *    Write the Traceback Routine End record
  2177.  */
  2178. VMS_TBT_Routine_End(Size)
  2179. {
  2180.     char Local[16];
  2181.  
  2182.     /*
  2183.      *    Record Size
  2184.      */
  2185.     Local[0] = 6;
  2186.     /*
  2187.      *    End of Routine
  2188.      */
  2189.     Local[1] = DST$C_RTNEND;
  2190.     /*
  2191.      *    Unused
  2192.      */
  2193.     Local[2] = 0;
  2194.     /*
  2195.      *    Size of routine
  2196.      */
  2197.     *((long *)(Local+3)) = Size;
  2198.     /*
  2199.      *    Store the record
  2200.      */
  2201.     VMS_Store_Immediate_Data(Local,7, OBJ$C_TBT);
  2202. }
  2203.  
  2204.  
  2205. /*
  2206.  *    Write a Line number / PC correlation record
  2207.  */
  2208. VMS_TBT_Line_PC_Correlation(Line_Number, Offset, Psect, Do_Delta)
  2209. int Line_Number;
  2210. int Offset;
  2211. int Psect;
  2212. int Do_Delta;
  2213. {
  2214.     register char *cp;
  2215.     char Local[64];
  2216.  
  2217.     /*
  2218.      *    If not delta, set our PC/Line number correlation
  2219.      */
  2220.     if (Do_Delta == 0) {
  2221.         /*
  2222.          *    Size
  2223.          */
  2224.         Local[0] = 1+1+2+1+4;
  2225.         /*
  2226.          *    Line Number/PC correlation
  2227.          */
  2228.         Local[1] = DST$C_LINE_NUM;
  2229.         /*
  2230.          *    Set Line number
  2231.          */
  2232.         Local[2] = DST$C_SET_LINE_NUM;
  2233.         *((unsigned short *)(Local+3)) = Line_Number-1;
  2234.         /*
  2235.          *    Set PC
  2236.          */
  2237.         Local[5] = DST$C_SET_ABS_PC;
  2238.         VMS_Store_Immediate_Data(Local, 6, OBJ$C_TBT);
  2239.         /*
  2240.          *    Make sure we are still generating a OBJ$C_TBT record
  2241.          */
  2242.         if (Object_Record_Offset == 0) PUT_CHAR(OBJ$C_TBT);
  2243.         if (Psect < 255) {
  2244.             PUT_CHAR(TIR$C_STA_PL);
  2245.             PUT_CHAR(Psect);
  2246.         } else {
  2247.             PUT_CHAR(TIR$C_STA_WPL);
  2248.             PUT_SHORT(Psect);
  2249.         }
  2250.         PUT_LONG(Offset);
  2251.         PUT_CHAR(TIR$C_STO_PIDR);
  2252.         /*
  2253.          *    Do a PC offset of 0 to register the line number
  2254.          */
  2255.         Local[0] = 2;
  2256.         Local[1] = DST$C_LINE_NUM;
  2257.         Local[2] = 0;    /* Increment PC by 0 and register line # */
  2258.         VMS_Store_Immediate_Data(Local, 3, OBJ$C_TBT);
  2259.     } else {
  2260.         /*
  2261.          *    If Delta is negative, terminate the line numbers
  2262.          */
  2263.         if (Do_Delta < 0) {
  2264.             Local[0] = 1+1+4;
  2265.             Local[1] = DST$C_LINE_NUM;
  2266.             Local[2] = DST$C_TERM_L;
  2267.             *((long *)(Local+3)) = Offset;
  2268.             VMS_Store_Immediate_Data(Local, 7, OBJ$C_TBT);
  2269.             /*
  2270.              *    Done
  2271.              */
  2272.             return;
  2273.         }
  2274.         /*
  2275.          *    Do a PC/Line delta
  2276.          */
  2277.         cp = Local+1;
  2278.         *cp++ = DST$C_LINE_NUM;
  2279.         if (Line_Number > 1) {
  2280.             /*
  2281.              *    We need to increment the line number
  2282.              */
  2283.             if (Line_Number-1 <= 255) {
  2284.                 *cp++ = DST$C_INCR_LINUM;
  2285.                 *cp++ = Line_Number-1;
  2286.             } else {
  2287.                 *cp++ = DST$C_INCR_LINUM_W;
  2288.                 *(short *)cp = Line_Number-1;
  2289.                 cp += sizeof(short);
  2290.             }
  2291.         }
  2292.         /*
  2293.          *    Increment the PC
  2294.          */
  2295.         if (Offset <= 128) {
  2296.             *cp++ = -Offset;
  2297.         } else {
  2298.             if (Offset < 0x10000) {
  2299.                 *cp++ = DST$C_DELTA_PC_W;
  2300.                 *(short *)cp = Offset;
  2301.                 cp += sizeof(short);
  2302.             } else {
  2303.                 *cp++ = DST$C_DELTA_PC_L;
  2304.                 *(long *)cp = Offset;
  2305.                 cp += sizeof(long);
  2306.             }
  2307.         }
  2308.         Local[0] = cp - (Local+1);
  2309.         VMS_Store_Immediate_Data(Local,cp - Local, OBJ$C_TBT);
  2310.     }
  2311. }
  2312.  
  2313.  
  2314. /*
  2315.  *    Describe a source file to the debugger
  2316.  */
  2317. VMS_TBT_Source_File(Filename, ID_Number)
  2318. char *Filename;
  2319. int ID_Number;
  2320. {
  2321.     register char *cp,*cp1;
  2322.     int Status,i;
  2323.     char Local[512];
  2324.     static struct FAB Fab;
  2325.     static struct NAM Nam;
  2326.     static struct XABDAT Date_Xab;
  2327.     static struct XABFHC File_Header_Xab;
  2328.     char Es_String[255],Rs_String[255];
  2329.  
  2330.     /*
  2331.      *    Setup the Fab
  2332.      */
  2333.     Fab.fab$b_bid = FAB$C_BID;
  2334.     Fab.fab$b_bln = sizeof(Fab);
  2335.     Fab.fab$l_nam = (&Nam);
  2336.     Fab.fab$l_xab = (struct XAB *)&Date_Xab;
  2337.     /*
  2338.      *    Setup the Nam block so we can find out the FULL name
  2339.      *    of the source file.
  2340.      */
  2341.     Nam.nam$b_bid = NAM$C_BID;
  2342.     Nam.nam$b_bln = sizeof(Nam);
  2343.     Nam.nam$l_rsa = Rs_String;
  2344.     Nam.nam$b_rss = sizeof(Rs_String);
  2345.     Nam.nam$l_esa = Es_String;
  2346.     Nam.nam$b_ess = sizeof(Es_String);
  2347.     /*
  2348.      *    Setup the Date and File Header Xabs
  2349.      */
  2350.     ((struct XAB *)&Date_Xab)->xab$b_cod = XAB$C_DAT;
  2351.     ((struct XAB *)&Date_Xab)->xab$b_bln = sizeof(Date_Xab);
  2352.     ((struct XAB *)&Date_Xab)->xab$l_nxt = (struct XAB *)&File_Header_Xab;
  2353.     ((struct XAB *)&File_Header_Xab)->xab$b_cod = XAB$C_FHC;
  2354.     ((struct XAB *)&File_Header_Xab)->xab$b_bln = sizeof(File_Header_Xab);
  2355.     /*
  2356.      *    Get the file information
  2357.      */
  2358.     Fab.fab$l_fna = Filename;
  2359.     Fab.fab$b_fns = strlen(Filename);
  2360.     Status = sys$open(&Fab);
  2361.     if (!(Status & 1)) {
  2362.         printf("gas: Couldn't find source file \"%s\", Error = %%X%x\n",
  2363.                 Filename, Status);
  2364.         return(0);
  2365.     }
  2366.     sys$close(&Fab);
  2367.     /*
  2368.      *    Calculate the size of the resultant string
  2369.      */
  2370.     i = Nam.nam$b_rsl;
  2371.     /*
  2372.      *    Size of record
  2373.      */
  2374.     Local[0] = 1+1+1+1+1+2+8+4+2+1+1+i+1+1+2+1+4;
  2375.     /*
  2376.      *    Source declaration
  2377.      */
  2378.     Local[1] = DST$C_SOURCE;
  2379.     /*
  2380.      *    Make formfeeds count as source records
  2381.      */
  2382.     Local[2] = DST$C_SRC_FORMFEED;
  2383.     /*
  2384.      *    Declare source file
  2385.      */
  2386.     Local[3] = DST$C_SRC_DECLFILE;    
  2387.     Local[4] = 1+2+8+4+2+1+1+i+1;
  2388.     cp = Local+5;
  2389.     /*
  2390.      *    Flags
  2391.      */
  2392.     *cp++ = 0;
  2393.     /*
  2394.      *    File ID
  2395.      */
  2396.     *(short *)cp = ID_Number;
  2397.     cp += sizeof(short);
  2398.     /*
  2399.      *    Creation Date
  2400.      */
  2401.     *(long *)cp = Date_Xab.xab$q_cdt[0];
  2402.     cp += sizeof(long);
  2403.     *(long *)cp = Date_Xab.xab$q_cdt[1];
  2404.     cp += sizeof(long);
  2405.     /*
  2406.      *    End of file block
  2407.      */
  2408.     *(long *)cp = File_Header_Xab.xab$l_ebk;
  2409.     cp += sizeof(long);
  2410.     /*
  2411.      *    First free byte
  2412.      */
  2413.     *(short *)cp = File_Header_Xab.xab$w_ffb;
  2414.     cp += sizeof(short);
  2415.     /*
  2416.      *    Record format
  2417.      */
  2418.     *cp++ = File_Header_Xab.xab$b_rfo;
  2419.     /*
  2420.      *    Filename
  2421.      */
  2422.     *cp++ = i;
  2423.     cp1 = Rs_String;
  2424.     while(--i >= 0) *cp++ = *cp1++;
  2425.     /*
  2426.      *    Library module name (none)
  2427.      */
  2428.     *cp++ = 0;
  2429.     /*
  2430.      *    Set Source File
  2431.      */
  2432.     *cp++ = DST$C_SRC_SETFILE;
  2433.     /*
  2434.      *    File ID Number
  2435.      */
  2436.     *(short *)cp = ID_Number;
  2437.     cp += sizeof(short);
  2438.     /*
  2439.      *    Set record number
  2440.      */
  2441.     *cp++ = DST$C_SRC_SETREC_L;
  2442.     *(long *)cp = 1;
  2443.     cp += sizeof(long);
  2444.     /*
  2445.      *    Done
  2446.      */
  2447.     VMS_Store_Immediate_Data(Local,cp - Local, OBJ$C_TBT);
  2448. }
  2449.  
  2450.  
  2451. /*
  2452.  *    Give the number of source lines to the debugger
  2453.  */
  2454. VMS_TBT_Source_Lines(Number_Of_Lines)
  2455. int Number_Of_Lines;
  2456. {
  2457.     char Local[8];
  2458.  
  2459.     /*
  2460.      *    Size of record
  2461.      */
  2462.     Local[0] = 1+1+2;
  2463.     /*
  2464.      *    Source declaration
  2465.      */
  2466.     Local[1] = DST$C_SOURCE;
  2467.     /*
  2468.      *    Define lines
  2469.      */
  2470.     Local[2] = DST$C_SRC_DEFLINES_W;
  2471.     *(short *)(Local+3) = Number_Of_Lines;
  2472.     /*
  2473.      *    Done
  2474.      */
  2475.     VMS_Store_Immediate_Data(Local, 5, OBJ$C_TBT);
  2476. }
  2477.  
  2478.  
  2479. /*
  2480.  *    Given the pointer to a symbol we calculate how big the data at the
  2481.  *    symbol is.  We do this by looking for the next symbol (local or
  2482.  *    global) which will indicate the start of another datum.
  2483.  */
  2484. int VMS_Initialized_Data_Size(sp, End_Of_Data)
  2485. register struct symbol *sp;
  2486. int End_Of_Data;
  2487. {
  2488.     register struct symbol *sp1,*Next_Symbol;
  2489.  
  2490.     /*
  2491.      *    Find the next symbol
  2492.      *    it delimits this datum
  2493.      */
  2494.     Next_Symbol = 0;
  2495.     for (sp1 = symbol_rootP; sp1; sp1 = sp1->sy_next) {
  2496.         /*
  2497.          *    The data type must match
  2498.          */
  2499.         if ((sp1->sy_nlist.n_type & ~N_EXT) != N_DATA) continue;
  2500.         /*
  2501.          *    The symbol must be AFTER this symbol
  2502.          */
  2503.         if (sp1->sy_nlist.n_value <= sp->sy_nlist.n_value) continue;
  2504.         /*
  2505.          *    We ignore THIS symbol
  2506.          */
  2507.         if (sp1 == sp) continue;
  2508.         /*
  2509.          *    If there is already a candidate selected for the
  2510.          *    next symbol, see if we are a better candidate
  2511.          */
  2512.         if (Next_Symbol) {
  2513.             /*
  2514.              *    We are a better candidate if we are "closer"
  2515.              *    to the symbol
  2516.              */
  2517.             if (sp1->sy_nlist.n_value >
  2518.                     Next_Symbol->sy_nlist.n_value)
  2519.                 continue;
  2520.             /*
  2521.              *    Win:  Make this the candidate
  2522.              */
  2523.             Next_Symbol = sp1;
  2524.         } else {
  2525.             /*
  2526.              *    This is the 1st candidate
  2527.              */
  2528.             Next_Symbol = sp1;
  2529.         }
  2530.     }
  2531.     /*
  2532.      *    Calculate its size
  2533.      */
  2534.     return(Next_Symbol ?
  2535.         (Next_Symbol->sy_nlist.n_value -
  2536.                 sp->sy_nlist.n_value) :
  2537.         (End_Of_Data - sp->sy_nlist.n_value));
  2538. }
  2539.  
  2540.  
  2541. /*
  2542.  *    This is a hacked _doprnt() for VAX-11 "C".  It understands that
  2543.  *    it is ONLY called by as_fatal(Format, Args) with a pointer to the
  2544.  *    "Args" argument.  From this we can make it all work right!
  2545.  */
  2546. #ifndef    eunice
  2547. _doprnt(Format, a, f)
  2548. char *Format;
  2549. FILE *f;
  2550. char **a;
  2551. {
  2552.     int Nargs = ((int *)a)[-2];    /* This understands as_fatal() */
  2553.  
  2554.     switch(Nargs) {
  2555.         default: fprintf(f,"_doprnt error on \"%s\"!!",Format); break;
  2556.         case 1:  fprintf(f,Format); break;
  2557.         case 2:  fprintf(f,Format,a[0]); break;
  2558.         case 3:  fprintf(f,Format,a[0],a[1]); break;
  2559.         case 4:  fprintf(f,Format,a[0],a[1],a[2]); break;
  2560.         case 5:  fprintf(f,Format,a[0],a[1],a[2],a[3]); break;
  2561.         case 6:  fprintf(f,Format,a[0],a[1],a[2],a[3],a[4]); break;
  2562.         case 7:  fprintf(f,Format,a[0],a[1],a[2],a[3],a[4],a[5]); break;
  2563.         case 8:  fprintf(f,Format,a[0],a[1],a[2],a[3],a[4],a[5],a[6]); break;
  2564.         case 9:  fprintf(f,Format,a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]); break;
  2565.         case 10: fprintf(f,Format,a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8]); break;
  2566.     }
  2567. }
  2568.  
  2569. #endif    /* eunice */
  2570.  
  2571. #endif    /* VMS */
  2572.